home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbmem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-12-17  |  17.3 KB  |  561 lines
  1. (*===========================================================================*)
  2. (* Memory handler                                                            *)
  3. (*                                                                           *)
  4. (*   Copyright 1989, 1990, 1991 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. {$DEFINE POINT_CHK}
  11. {$DEFINE FREE_CHK}
  12. {$UNDEF  DEBUG}
  13. {$UNDEF  DEBUG2} (* Trace allocate/free *)
  14. {$UNDEF  DEBUG3} (* Partial free *)
  15.  
  16. UNIT BBMEM;
  17.  
  18. INTERFACE
  19.  
  20. USES
  21.   bbdummy;
  22.  
  23. TYPE
  24.  
  25.   mem_list_start = BYTE;
  26.  
  27.   mem_list_ptr = ^mem_list;
  28.  
  29.   mem_list = RECORD
  30.                next_mem_list : mem_list_ptr;
  31.                mem_name      : mem_id_str;
  32.                mem_size      : WORD;
  33.                mem_start     : mem_list_start;
  34.              END;
  35.  
  36. CONST
  37.   mem_overhead = SIZEOF(mem_list) - SIZEOF(mem_list_start);
  38.  
  39.   memid_call_scanned     = 'CS';
  40.   search_memory_block_id = 'MSB';
  41.  
  42.  
  43. FUNCTION  get_task_mem(name_of_mem : mem_id_str;
  44.                        mem_size_to_get : WORD) : POINTER;
  45.  
  46. FUNCTION  get_task_text_buff(name_of_mem : mem_id_str) : POINTER;
  47.  
  48. FUNCTION  find_task_mem_addr(name_of_mem : mem_id_str) : POINTER;
  49.  
  50. FUNCTION  find_task_mem_size(name_of_mem : mem_id_str) : WORD;
  51.  
  52. PROCEDURE free_task_mem(name_of_mem : mem_id_str; free_all : BOOLEAN);
  53.  
  54. PROCEDURE free_task_mem_end(name_of_mem : mem_id_str; size_to_free : WORD);
  55.  
  56. PROCEDURE move_task_mem(mem_id   : mem_id_str;
  57.                         from_tcb : tcb_ptr;
  58.                         to_tcb   : tcb_ptr);
  59.  
  60. PROCEDURE free_task_mem_all(this_tcb : tcb_ptr);
  61.  
  62. IMPLEMENTATION
  63.  
  64.   USES
  65.     bbbug,
  66.     bbmisc3,
  67.     bbtrace;
  68.  
  69. (*===========================================================================*)
  70. (* Get task memory                                                           *)
  71. (*===========================================================================*)
  72.  
  73. FUNCTION  get_task_mem(name_of_mem : mem_id_str;
  74.                        mem_size_to_get : WORD) : POINTER;
  75.  
  76.   VAR
  77.     new_mem : mem_list_ptr;
  78.     size    : LONGINT;
  79.  
  80.   BEGIN;
  81.  
  82.     {$IFDEF POINT_CHK}
  83.       IF active_tcb^.stor_list <> NIL THEN
  84.         test_pointer(active_tcb^.stor_list);
  85.     {$ENDIF}
  86.  
  87.     size := LONGINT(mem_overhead) + mem_size_to_get;
  88.  
  89.     GETMEM(new_mem, size);
  90.  
  91.     {$IFDEF DEBUG2}
  92.       trace_data('MEG', size, new_mem, name_of_mem);
  93.     {$ENDIF}
  94.  
  95.     new_mem^.next_mem_list := active_tcb^.stor_list;
  96.     new_mem^.mem_name      := name_of_mem;
  97.     new_mem^.mem_size      := mem_size_to_get;
  98.  
  99.     active_tcb^.stor_list  := new_mem;
  100.  
  101.     get_task_mem := ADDR(new_mem^.mem_start);
  102.  
  103.     {$IFDEF DEBUG}
  104.       WRITELN('MEM get - ', name_of_mem, ' - ', mem_size_to_get,
  105.                           ' - ', p2x(active_tcb^.stor_list),
  106.                           ' - ', p2x(ADDR(new_mem^.mem_start)));
  107.     {$ENDIF}
  108.  
  109.   END;
  110.  
  111. (*===========================================================================*)
  112. (* Get a text buffer                                                         *)
  113. (*===========================================================================*)
  114.  
  115. FUNCTION  get_task_text_buff(name_of_mem : mem_id_str) : POINTER;
  116.  
  117.   VAR
  118.     size_to_get : LONGINT;
  119.  
  120.   BEGIN;
  121.  
  122.     size_to_get := MAXAVAIL div 2;
  123.  
  124.     IF size_to_get > 10240 THEN
  125.       size_to_get := 10240;
  126.  
  127.     get_task_text_buff := get_task_mem(name_of_mem, size_to_get);
  128.  
  129.   END;
  130.  
  131. (*===========================================================================*)
  132. (* Find task memory                                                          *)
  133. (*===========================================================================*)
  134.  
  135. FUNCTION  find_task_mem(name_of_mem : mem_id_str) : mem_list_ptr;
  136.  
  137.   VAR
  138.     look_mem : mem_list_ptr;
  139.  
  140.   BEGIN;
  141.  
  142.     look_mem := active_tcb^.stor_list;
  143.  
  144.     WHILE (look_mem <> NIL) AND (look_mem^.mem_name <> name_of_mem) DO
  145.       look_mem := look_mem^.next_mem_list;
  146.  
  147.     find_task_mem := look_mem;
  148.  
  149.   END;
  150.  
  151. (*===========================================================================*)
  152. (* Find the address of a task memory block                                   *)
  153. (*===========================================================================*)
  154.  
  155. FUNCTION  find_task_mem_addr(name_of_mem : mem_id_str) : POINTER;
  156.  
  157.   VAR
  158.     look_mem : mem_list_ptr;
  159.  
  160.   BEGIN;
  161.  
  162.     look_mem := find_task_mem(name_of_mem);
  163.  
  164.     IF look_mem <> NIL THEN
  165.       find_task_mem_addr := ADDR(look_mem^.mem_start)
  166.     ELSE
  167.       find_task_mem_addr := NIL;
  168.  
  169.   END;
  170.  
  171. (*===========================================================================*)
  172. (* Find the size of a task memory block                                      *)
  173. (*===========================================================================*)
  174.  
  175. FUNCTION  find_task_mem_size(name_of_mem : mem_id_str) : WORD;
  176.  
  177.   VAR
  178.     look_mem : mem_list_ptr;
  179.  
  180.   BEGIN;
  181.  
  182.     look_mem := find_task_mem(name_of_mem);
  183.  
  184.     IF look_mem <> NIL THEN
  185.       find_task_mem_size := look_mem^.mem_size
  186.     ELSE
  187.       find_task_mem_size := 0;
  188.  
  189.   END;
  190.  
  191. (*===========================================================================*)
  192. (* Free task memory block -- May free all with the same name                 *)
  193. (*===========================================================================*)
  194.  
  195. PROCEDURE free_task_mem(name_of_mem : mem_id_str; free_all : BOOLEAN);
  196.  
  197.   VAR
  198.     last_mem : mem_list_ptr;
  199.     look_mem : mem_list_ptr;
  200.     next_mem : mem_list_ptr;
  201.     size     : LONGINT;
  202.  
  203.   BEGIN;
  204.  
  205.     {$IFDEF DEBUG}
  206.       WRITELN('MEM free - ', name_of_mem);
  207.     {$ENDIF}
  208.  
  209.     (*-----------------------------------------------------------------------*)
  210.     (* Initialize the loop                                                   *)
  211.     (*-----------------------------------------------------------------------*)
  212.  
  213.     last_mem := NIL;
  214.     look_mem := active_tcb^.stor_list;
  215.  
  216.     (*-----------------------------------------------------------------------*)
  217.     (* Look thru the memory list                                             *)
  218.     (*-----------------------------------------------------------------------*)
  219.  
  220.     WHILE look_mem <> NIL  DO
  221.       BEGIN;
  222.  
  223.         {$IFDEF POINT_CHK}
  224.           test_pointer(look_mem);
  225.         {$ENDIF}
  226.  
  227.         {$IFDEF DEBUG}
  228.           WRITELN('MEM free loop - ', p2x(look_mem), ' - ',
  229.                                                            look_mem^.mem_name);
  230.         {$ENDIF}
  231.  
  232.         (*-------------------------------------------------------------------*)
  233.         (* Where do we go from here?                                         *)
  234.         (*-------------------------------------------------------------------*)
  235.  
  236.         next_mem := look_mem^.next_mem_list;
  237.  
  238.         (*-------------------------------------------------------------------*)
  239.         (* Check for a match.  If none, establish a new back pointer         *)
  240.         (*-------------------------------------------------------------------*)
  241.  
  242.         IF look_mem^.mem_name <> name_of_mem THEN
  243.           last_mem := look_mem
  244.         ELSE
  245.           BEGIN;
  246.  
  247.             (*---------------------------------------------------------------*)
  248.             (* Remove this block from the thread's chain                     *)
  249.             (*---------------------------------------------------------------*)
  250.  
  251.             IF last_mem = NIL THEN
  252.               active_tcb^.stor_list   := look_mem^.next_mem_list
  253.             ELSE
  254.               last_mem^.next_mem_list := look_mem^.next_mem_list;
  255.  
  256.             (*---------------------------------------------------------------*)
  257.             (* Free the space                                                *)
  258.             (*---------------------------------------------------------------*)
  259.  
  260.             size := LONGINT(mem_overhead) + look_mem^.mem_size;
  261.  
  262.             {$IFDEF DEBUG}
  263.               WRITELN('MEM free now - ', p2x(look_mem), ' - ', size);
  264.               heap_dump;
  265.             {$ENDIF}
  266.  
  267.             {$IFDEF DEBUG2}
  268.               trace_data('MEF', size, look_mem, look_mem^.mem_name);
  269.             {$ENDIF}
  270.  
  271.             FILLCHAR(look_mem^, size, $F1);
  272.             FREEMEM(look_mem, size);
  273.  
  274.             {$IFDEF FREE_CHK}
  275.               test_free_list;
  276.             {$ENDIF}
  277.  
  278.             (*---------------------------------------------------------------*)
  279.             (* If we only want to free the top one, we are done              *)
  280.             (*---------------------------------------------------------------*)
  281.  
  282.             IF NOT free_all THEN EXIT;
  283.  
  284.           END;
  285.  
  286.         (*-------------------------------------------------------------------*)
  287.         (* Chain forward                                                     *)
  288.         (*-------------------------------------------------------------------*)
  289.  
  290.         look_mem := next_mem;
  291.  
  292.       END;
  293.  
  294.   END;
  295.  
  296. (*===========================================================================*)
  297. (* Free the end of an item                                                   *)
  298. (*===========================================================================*)
  299.  
  300. PROCEDURE free_task_mem_end(name_of_mem : mem_id_str; size_to_free : WORD);
  301.  
  302.   VAR
  303.     i        : WORD;
  304.     l        : LONGINT;
  305.     look_mem : mem_list_ptr;
  306.     offset   : WORD;
  307.     segment  : WORD;
  308.  
  309.  
  310.   BEGIN;
  311.  
  312.     {$IFDEF DEBUG}
  313.       WRITELN('MEM free end - ', name_of_mem, ' / ', size_to_free);
  314.     {$ENDIF}
  315.  
  316.     {$IFDEF DEBUG3}
  317.       WRITELN('MEM free end - ', name_of_mem, ' / ', size_to_free);
  318.     {$ENDIF}
  319.  
  320.     (*-----------------------------------------------------------------------*)
  321.     (* If nothing to free then leave                                         *)
  322.     (*-----------------------------------------------------------------------*)
  323.  
  324.     IF size_to_free = 0 THEN EXIT;
  325.  
  326.     (*-----------------------------------------------------------------------*)
  327.     (* Find the control block to free                                        *)
  328.     (*-----------------------------------------------------------------------*)
  329.  
  330.     look_mem := find_task_mem(name_of_mem);
  331.  
  332.     (*-----------------------------------------------------------------------*)
  333.     (* If nothing found then exit                                            *)
  334.     (*-----------------------------------------------------------------------*)
  335.  
  336.     IF look_mem = NIL THEN EXIT;
  337.  
  338.     {$IFDEF POINT_CHK}
  339.       test_pointer(look_mem);
  340.     {$ENDIF}
  341.  
  342.     (*-----------------------------------------------------------------------*)
  343.     (* Get current data size and the full control block size                 *)
  344.     (*-----------------------------------------------------------------------*)
  345.  
  346.     offset := look_mem^.mem_size;
  347.     l      := offset + LONGINT(mem_overhead);
  348.  
  349.     (*-----------------------------------------------------------------------*)
  350.     (* Calculate how much will be left                                       *)
  351.     (*-----------------------------------------------------------------------*)
  352.  
  353.     i := offset - size_to_free;
  354.  
  355.     (*-----------------------------------------------------------------------*)
  356.     (* If nothing then free it all                                           *)
  357.     (*-----------------------------------------------------------------------*)
  358.  
  359.     IF i <= 0 THEN
  360.       BEGIN;
  361.         free_task_mem(name_of_mem, FALSE);
  362.  
  363.         {$IFDEF FREE_CHK}
  364.           test_free_list;
  365.         {$ENDIF}
  366.  
  367.         EXIT;
  368.       END;
  369.  
  370.     (*-----------------------------------------------------------------------*)
  371.     (* Put updated size back                                                 *)
  372.     (*-----------------------------------------------------------------------*)
  373.  
  374.     look_mem^.mem_size := i;
  375.  
  376.     (*-----------------------------------------------------------------------*)
  377.     (* Change size to true block size                                        *)
  378.     (*-----------------------------------------------------------------------*)
  379.  
  380.     INC(i, mem_overhead);
  381.     INC(offset, mem_overhead);
  382.  
  383.     (*-----------------------------------------------------------------------*)
  384.     (* If new TURBO storage manager then only deal in chunks                 *)
  385.     (*-----------------------------------------------------------------------*)
  386.  
  387.     {$IFNDEF VER55}
  388.  
  389.       i := 8 * ((i + 7) DIV 8);
  390.  
  391.       {$IFDEF DEBUG3}
  392.         WRITELN('MEM free end chunk - ', offset, ' / ', i);
  393.       {$ENDIF}
  394.  
  395.       IF offset <= i THEN EXIT;
  396.  
  397.       size_to_free := offset - i;
  398.  
  399.       {$IFDEF DEBUG3}
  400.         WRITELN('MEM free end chuck - ', size_to_free, ' / ', i);
  401.       {$ENDIF}
  402.  
  403.     {$ENDIF}
  404.  
  405.     (*-----------------------------------------------------------------------*)
  406.     (* Calculate start of area to free                                       *)
  407.     (*-----------------------------------------------------------------------*)
  408.  
  409.     {$IFDEF DEBUG}
  410.       WRITELN('MEM free end start - ', p2x(look_mem), ' / ', i);
  411.     {$ENDIF}
  412.  
  413.     {$IFDEF DEBUG3}
  414.       WRITELN('MEM free end start - ', p2x(look_mem), ' / ', i);
  415.     {$ENDIF}
  416.  
  417.     i := i + OFS(look_mem^);
  418.  
  419.     {$IFDEF DEBUG}
  420.       WRITELN('MEM free end calc - ', p2x(look_mem), ' / ', i);
  421.     {$ENDIF}
  422.  
  423.     {$IFDEF DEBUG3}
  424.       WRITELN('MEM free end calc - ', p2x(look_mem), ' / ', i);
  425.     {$ENDIF}
  426.  
  427.     segment := SEG(look_mem^);
  428.     segment := segment + i DIV 16;
  429.     i       := i AND $F;
  430.     look_mem := PTR(segment, i);
  431.  
  432.     {$IFDEF POINT_CHK}
  433.       test_pointer(look_mem);
  434.     {$ENDIF}
  435.  
  436.     {$IFDEF DEBUG}
  437.       WRITELN('MEM free end actual - ', p2x(look_mem), ' / ', size_to_free);
  438.     {$ENDIF}
  439.  
  440.     {$IFDEF DEBUG2}
  441.       trace_data('MES', size_to_free, look_mem, name_of_mem);
  442.     {$ENDIF}
  443.  
  444.     {$IFDEF DEBUG3}
  445.       WRITELN('MEM free end actual - ', p2x(look_mem), ' / ', size_to_free);
  446.     {$ENDIF}
  447.  
  448.     (*-----------------------------------------------------------------------*)
  449.     (* Free it                                                               *)
  450.     (*-----------------------------------------------------------------------*)
  451.  
  452.     FILLCHAR(look_mem^, size_to_free, $F2);
  453.     FREEMEM(look_mem, size_to_free);
  454.  
  455.     {$IFDEF FREE_CHK}
  456.       test_free_list;
  457.     {$ENDIF}
  458.  
  459.   END;
  460.  
  461. (*===========================================================================*)
  462. (* Move task memory                                                          *)
  463. (*===========================================================================*)
  464.  
  465. PROCEDURE move_task_mem(mem_id   : mem_id_str;
  466.                         from_tcb : tcb_ptr;
  467.                         to_tcb   : tcb_ptr);
  468.   VAR
  469.     last_mem : mem_list_ptr;
  470.     look_mem : mem_list_ptr;
  471.  
  472.   BEGIN;
  473.  
  474.     {$IFDEF DEBUG}
  475.       WRITELN('MEM move - ', mem_id);
  476.     {$ENDIF}
  477.  
  478.     (*-----------------------------------------------------------------------*)
  479.     (* Locate the block we want                                              *)
  480.     (*-----------------------------------------------------------------------*)
  481.  
  482.     last_mem := NIL;
  483.     look_mem := from_tcb^.stor_list;
  484.  
  485.     WHILE (look_mem <> NIL) AND (look_mem^.mem_name <> mem_id) DO
  486.       BEGIN;
  487.         last_mem := look_mem;
  488.         look_mem := look_mem^.next_mem_list;
  489.       END;
  490.  
  491.     (*-----------------------------------------------------------------------*)
  492.     (* If nothing found then exit                                            *)
  493.     (*-----------------------------------------------------------------------*)
  494.  
  495.     IF look_mem = NIL THEN
  496.       EXIT;
  497.  
  498.     {$IFDEF POINT_CHK}
  499.       test_pointer(look_mem);
  500.     {$ENDIF}
  501.  
  502.     (*-----------------------------------------------------------------------*)
  503.     (* Remove this memory from old thread                                    *)
  504.     (*-----------------------------------------------------------------------*)
  505.  
  506.     IF last_mem = NIL THEN
  507.       from_tcb^.stor_list := look_mem^.next_mem_list
  508.     ELSE
  509.       last_mem^.next_mem_list := look_mem^.next_mem_list;
  510.  
  511.     (*-----------------------------------------------------------------------*)
  512.     (* Add to head of new thread's list                                      *)
  513.     (*-----------------------------------------------------------------------*)
  514.  
  515.     look_mem^.next_mem_list := to_tcb^.stor_list;
  516.  
  517.     to_tcb^.stor_list := look_mem;
  518.  
  519.   END;
  520.  
  521. (*===========================================================================*)
  522. (* Free all memory for a task                                                *)
  523. (*===========================================================================*)
  524.  
  525. PROCEDURE free_task_mem_all(this_tcb : tcb_ptr);
  526.  
  527.   VAR
  528.     next_mem : mem_list_ptr;
  529.     size     : LONGINT;
  530.     this_mem : mem_list_ptr;
  531.  
  532.   BEGIN;
  533.  
  534.     (*-----------------------------------------------------------------------*)
  535.     (* Free random storage                                                   *)
  536.     (*-----------------------------------------------------------------------*)
  537.  
  538.     this_mem := this_tcb^.stor_list;
  539.  
  540.     IF this_mem <> NIL THEN
  541.       BEGIN;
  542.  
  543.         this_tcb^.stor_list := NIL;
  544.  
  545.         REPEAT
  546.  
  547.           next_mem := this_mem^.next_mem_list;
  548.           size := LONGINT(mem_overhead) + this_mem^.mem_size;
  549.  
  550.           FREEMEM(this_mem, size);
  551.  
  552.           this_mem := next_mem;
  553.  
  554.         UNTIL this_mem = NIL;
  555.  
  556.       END;
  557.  
  558.   END;
  559.  
  560. END.
  561.